Welcome to my 2022 Projections for Pitchers 5x5

Projections using Hypertuned model through XGboost

All data is from FanGraphs. I have no affiliation with FanGraphs, but please consider contributing to their website if you found this project informative.

1 Project Scope

1.1 Objective

This project is designed to showcase how Using a Percentile Based Worth System values Fantasy Baseball Players through a Inning Pitched (IP) weighted projection

The Categories used for prediction valuation are year-end rankings for the following metrics:

• Wins
• Saves
• Strike Outs
• ERA ( 9 * Earned Runs per Inning Pitched)
• WHIP (Walks and Hits per Inning Pitched)

---

---

2 Processing the Data

2.1 Getting Data Into R

2.1.1 Load Libraries

First we need to load the packages that R needs to run the analysis

library(sqldf) #SQL in R
library(skimr) #Summaries and useful for removing low % data
library(ggplot2) #Plotting Functions
library(plyr) #slightly deprecated data cleaning
library(dplyr) #slightly updated data cleaning
library(tidyverse) #tidyverse data cleaning universe
library(caret) #wrapper for creating, tuning and validating models
library(xgboost) #package for creating regression tree model
library(vtreat) # useful package for treating data before modeling 
library(Matrix)
library(Boruta)
library(mgcv)
library(moments) #for measuring skewness
library(data.table) #alternative to dplyr we use to create lags
library(pdp) #partial dependence graphs
library(vip) #variable importance 
library(grid) #put multiple plots on one grid
library(gridExtra) #additional grid functionality
library(janitor) #one function used to clean transposed data set
library(ggpubr) #for qq plot
library(tableHTML)
library(kableExtra)
library(owmr)

The # comments generally explain what additional functionality each library adds to R

2.1.2 Load in Data

All data is downloaded from Fan Graphs. From this location. The data is also available on my Github here. There are player level and team data sets

#data read-in
pitcher_data <- read_csv("FanGraphs Leaderboard_Pitching20IP.csv")

#Team datasets
FDG_Team = read_csv("FanGraphs Leaderboard_Team.csv")

#Create a prefix for all team stats that starts with T_
FDG_Team2 <- FDG_Team %>% 
  rename_with( ~ paste0("T_", .x))

2.1.3 Checking Team Data

str give information about an object, while skim provides a customizable summary

#Output not shown for space
#str(FDG_Team2)

skim(FDG_Team2) %>%  
  tibble::as_tibble()

NA
NA

---

2.2 Understanding the Dataset

2.2.1 Exploring the dataset

skim let’s us see how the data was imported into R. Documentation can be found here

#Full Dataset dimensions

skimr::skim(pitcher_data) %>% 
  tibble::as_tibble() %>% 
  select(skim_type,skim_variable,complete_rate) %>% 
  filter(complete_rate >0.30) #288 Variables

#skim_type - character or numeric
#skim_variable - name of variable
#complete_rate - % of data that is not missing
#filter - only keep variables that have 30% of data populated

Additionally let’s look at how variables vary by year to see if there are any discrepancies there

#It looks like one year, there were fewer games played, and there is a clear drop off in home runs
pitcher_data_dist =
pitcher_data %>% 
 group_by(Season) %>% 
  summarize (Max_Games = max(G),
             Avg_W= mean(W)
             )
pitcher_data_dist

ggplot(pitcher_data_dist, aes(Season, Avg_W)) +
  geom_col()+
  ggtitle("Average Wins by Year")+
  theme(plot.title = element_text(hjust = 0.5,size = 22,color ="steel blue"))

NA
NA
NA

---

2.3 Cleaning and Creating Initial Dataset for Model

What are some issues with the data?

1. Many of Variables, such as K%, are being read in as characters

   • Only Team and Player Name should be characters

2. There is spotty data coverage in some of the variables (~Variables have less than 30% Coverage)

3. 2020 Data only includes 60 games worth of data

   • This was a season shortened due to Covid-19

4. Team Data needs to be appended to pitcher Data by Team Name

---

2.3.1 Cleanly Changing all Variables that are characters to numeric.

There are several ways to do this, we will identify the variables we want to change that are mis-identified. parse_number can be used to pull numbers from these variables. Additional ways to tackle this can be found here

#Select Column names that are characters but not Team or Name, These should be percentages
pitcher_data_chars_to_convert <- pitcher_data %>% 
  select_if(is.character)%>% select(-Team,-Name) %>% 
  mutate_all (function(x) as.numeric(readr::parse_number(x))/100)
#Note : There are additional ways to do this, this is just one solution


#We can exclude the variables we converted and reintroduce them
pitcher_data_num <- pitcher_data %>% select(-colnames(pitcher_data_chars_to_convert))

pitcher_data2 = cbind(pitcher_data_num,pitcher_data_chars_to_convert) %>% 
  select (colnames(pitcher_data)) %>%  #preserve original order 
  dplyr::rename(flyball_perc = `FB%...50`,fastball_perc = `FB%...74`) #rename two ambiguous columns
  
skim(pitcher_data2) %>% 
  as_tibble() %>% 
  group_by(skim_type) %>% 
  count()

#Logical variables are R's best guess, in our case they are all NA's and will be removed

The same can be done for the Team Data that is loaded

#Select Column names that are characters but not Team or Name, These should be percentages
FDG_Team2_chars_to_convert <- FDG_Team2 %>% 
  select_if(is.character)%>% select(-T_Team) %>% 
  mutate_all (function(x) as.numeric(readr::parse_number(x))/100)
#Keep in mind, parse number may make actual characters into numerical variables so carefully check your data before using

#We can exclude the variables we converted and reintroduce them
FDG_Team2_num <- FDG_Team2 %>% select(-colnames(FDG_Team2_chars_to_convert))

FDG_Team3 = cbind(FDG_Team2_num,FDG_Team2_chars_to_convert) %>% 
  select (colnames(FDG_Team2)) %>%  #preserve original order
dplyr::rename(T_flyball_perc = `T_FB%...45`,T_fastball_perc = `T_FB%...72`) 

skim(FDG_Team3) %>% 
  as_tibble() %>% 
  group_by(skim_type) %>% 
  count()

NA
NA
NA

---

2.3.2 Filtering Data with Low Coverage

I choose 30% coverage of data necessary but this can be adjusted up or down. This will also get rid of columns that are all NA.

# Keep variables with enough values (Need 30% data coverage rate here)
Player_cols_to_keep =
skim(pitcher_data2) %>% 
  dplyr::select(skim_type, skim_variable, complete_rate) %>% 
  filter (complete_rate > 0.30)

#Transpose Rows to get column names as skim melts the data
Player_cols_to_keep_transpose = t(Player_cols_to_keep) 

#extract the colnames we would like to keep
Player_cols_to_keep = colnames(janitor::row_to_names(Player_cols_to_keep_transpose,row_number = 2))

#Only keep the columns designated to have over 30% of their data populated or greater
pitcher_data3 = pitcher_data2 %>% 
  select(one_of(Player_cols_to_keep)) 

Repeat the process for Team Variables

Team_cols_to_keep =
skim(FDG_Team3) %>% 
  dplyr::select(skim_type, skim_variable, complete_rate) %>% 
  filter (complete_rate > 0.30)


#Transpose Rows to get column names as skim melts the data
Team_cols_to_keep_transpose = t(Team_cols_to_keep) 

#extract the colnames we would like to keep
Team_cols_to_keep = colnames(janitor::row_to_names(Team_cols_to_keep_transpose,row_number = 2))

#Only keep the columns designated to have over 30% of their data populated or greater
FDG_Team4 = FDG_Team3 %>% 
  select(one_of(Team_cols_to_keep)) 

---

2.3.3 Creating Variables Normalized by Year

Some Variables will need to be normalized by Innings_Pitched (IP) if they aren’t a percentage already. Remaining Variables are percentages or indices so will not need to be transformed

pitcher_data4 = pitcher_data3 %>% 
  mutate( #create new variables based on existing variables
    W_IP = W/IP,
    L_IP =  L/IP, 
    ShO_IP = ShO/IP,
    SV_IP = SV/IP,
    BS_IP = BS/IP,
    TBF_IP = TBF/IP,
    H_IP = H/IP,
    R_IP = R/IP,
    ER_IP = ER/IP,
    HR_IP=HR/IP,
    BB_IP=BB/IP,
    IBB_IP=IBB/IP,
    HBP_IP=HBP/IP,
    WP_IP= WP/IP,
    BK_IP=BK/IP,
    SO_IP=SO/IP,
    GB_IP = GB/IP,   #Groundballs
    FB_IP =  FB/IP,  #FlyBalls
    LD_IP = LD/IP,   #LineDrives
    IFFB_IP = IFFB/IP,  #Infield Fly balls
    Balls_IP= Balls/IP,
    Strikes_IP= Strikes/IP,
    Pitches_IP= Pitches/IP,
    RS_IP= RS/IP,
    IFH_IP= IFH/IP,
    BU_IP= BU/IP,
    BUH_IP= BUH/IP,
    Pulls_IP= Pulls/IP,
    HLD_IP= HLD/IP,   
    SD_IP= SD/IP,    
    MD_IP= MD/IP,    
    Barrels_IP= Barrels/IP,
    HardHits_IP= HardHit/IP
  ) %>% select(-L,-G,-IP,-ShO,-BS,-(TBF:BK),-(GB:BUH),-Pulls,-(SD:MD),-Barrels,-HardHit,-Events)
               
               #will be removed after lags -FIP,-(RAR:WPA),,-(wFB:wCH),-(`ERA-`:`xFIP-`),-SIERA,-(`RA9-WAR`:`Age Rng`),-kwERA,-`wCH (pi)`:`wSL (pi)`,`K/9+`:`HR/FB%+`) #Drop the old variables
#Be careful about RS - Run Support and RS/9

#skim(pitcher_data4) %>% as_tibble()

Repeat the process for Team Variables

FDG_Team5 = FDG_Team4 %>% 
  mutate( #create new variables based on existing variables
    T_H_T_PA = T_H/T_PA,
    T_x1B_T_PA = T_1B/T_PA, #note: R can't have variables start with a number
    T_x2b_T_PA = T_2B/T_PA,
    T_x3b_T_PA = T_3B/T_PA,
    T_HR_T_PA = T_HR/T_PA,
    T_R_T_PA = T_R/T_PA,
    T_RBI_T_PA = T_RBI/T_PA,
    T_BB_T_PA = T_BB/T_PA,
    T_IBB_T_PA = T_IBB/T_PA,
    T_SO_T_PA=T_SO/T_PA,
    T_HBP_T_PA=T_HBP/T_PA,
    T_SF_T_PA=T_SF/T_PA,
    T_SH_T_PA=T_SH/T_PA,
    T_GDP_T_PA= T_GDP/T_PA,#ground into double play
    T_SB_T_PA=T_SB/T_PA,
    T_CS_T_PA=T_CS/T_PA,
    T_GB_T_PA = T_GB/T_PA,   #Groundballs
    T_FB_T_PA =  T_FB/T_PA,  #FlyBalls
    T_LD_T_PA = T_LD/T_PA,   #LineDrives
    T_IFFB_T_PA = T_IFFB/T_PA,  #Infield Fly balls
    T_Pitches_T_PA= T_Pitches/T_PA,
    T_Balls_T_PA= T_Balls/T_PA,
    T_Strikes_T_PA= T_Strikes/T_PA,
    T_IFH_T_PA= T_IFH/T_PA,
    T_BU_T_PA= T_BU/T_PA,
    T_BUH_T_PA= T_BUH/T_PA,
    T_PH_T_PA= T_PH/T_PA,
    T_Barrels_T_PA= T_Barrels/T_PA,
    T_HardHits_T_PA= T_HardHit/T_PA
  ) %>% select(-(T_H:T_CS),-(T_GB:T_BUH),-T_PH,-T_Barrels,-T_HardHit,-T_Events) #Drop the old variables


#skim(FDG_Team5) %>% as_tibble()

---

2.3.4 Creating Lagged Variables

There are several ways to lag a dataset BY GROUP.
* Dplyr way is here..
* While data.table (the method used below) is here.

#Note we will only be lagging the player level data, as the previous year's team performance shouldn't impact current performance


#Order the dataset by lag columns
pitcher_data5 =  arrange(pitcher_data4, playerid,Season) #playerid is the Fangraph id assigned to each player

# Convert dataframe to data.table format
DT_pitcher = data.table(pitcher_data5)

#designate columns to lag - which is all of them
cols1 = colnames(pitcher_data5)
anscols = paste("lag", cols1, sep="_")
DT_pitcher[, (anscols) := data.table::shift(.SD, 1, NA, "lag"),by ='playerid', .SDcols=cols1] #Create 1 period lags by year

pitcher_data6 = as.data.frame(DT_pitcher) %>% select(-lag_playerid, -lag_Team, -lag_Season, -lag_Age,-lag_Name)

ncol(pitcher_data5) #250 - no lags

[1] 251

ncol(pitcher_data6) #495 - lagged data ~ (250 * 2)-5

[1] 497

---

2.3.5 Merging Team and Player Data

We can use either the merge function or the SQL functionality provided by the sqldf package to join the lagged player level data to the Team level data

df_pitching_init = sqldf(
  "
  select a.*, b.*
  from pitcher_data6 a
  left join FDG_Team5 b
  on a.Team = b.T_Team and a.Season = b.T_Season
  
  "
)  %>% select(-T_Team,-T_Season,-T_Age,-T_G,-T_AB)# Unncessary Team Variables


nrow(df_pitching_init) - nrow(pitcher_data6) #check if any rows are duplicated

[1] 0

---

3 Creating Rankings for Players Based On Percentiles

We can use Percentile based ranking to get rankings for players from the 2021 season.

3.1 Worth of each stat

3.1.1 Calculating past performance

Each player goes from a 0% to 100% on each percentile stat that is used for creating a scoring opportunity. All data is already normalized by plate appearances, but must now be ranked for each year.

#Categories I include are:
#Wins, Saves, WHIP, ERA, SOs, Holds

df_pitching_init2 =  df_pitching_init %>%
#  arrange(player_id,year) %>% 
  group_by(Season) %>% 
  mutate(
    Wins_share = order(order(rank(W_IP,ties.method = 'average'),decreasing = FALSE))/n(),
     SO_share = order(order(rank(SO_IP,ties.method = 'average'),decreasing = FALSE))/n(),
     SV_share = order(order(rank(SV_IP,ties.method = 'average'),decreasing = FALSE))/n(),
     WHIP_share = order(order(rank(WHIP,ties.method = 'average'),decreasing = FALSE))/n(),
     ERA_share = order(order(rank(ERA,ties.method = 'average'),decreasing = FALSE))/n(),
    HLD_share = 0,
    Worth = Wins_share+SO_share+SV_share+WHIP_share+ERA_share+HLD_share
    ) %>% 
  ungroup() 

Chart of the Distribution of initial percentiles
As the chart below shows, the data is roughly normal.

skewness((df_pitching_init2$Worth))

[1] 0.086

ggplot2::qplot(df_pitching_init2$Worth, main="Total Pitching Worth Dataset") + geom_histogram(colour="black", fill="grey") + theme_bw()

`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

min(df_pitching_init2$Worth)

[1] 0.32

max(df_pitching_init2$Worth)

[1] 4.6

ggpubr::ggqqplot(df_pitching_init2$Worth)

shapiro.test(df_pitching_init2$Worth)

    Shapiro-Wilk normality test

data:  df_pitching_init2$Worth
W = 1, p-value = 0.002

---

3.2 2021 Player Rankings - Per IP performance

3.2.1 2021 Player Rankings - Top Worth Players

While it looks like many of the top players have low worth scores, it is because we haven’t applied a modifier for IP yet. Wins are harder to come by relative to any other stat and require more innings pitched.

df_pitching_init2_raw =  df_pitching_init %>%
#  arrange(player_id,year) %>% 
  group_by(Season) %>% 
  mutate(
    Wins_share_raw = order(order(rank(W,ties.method = 'average'),decreasing = FALSE))/n(),
     SO_share_raw = order(order(rank(SO,ties.method = 'average'),decreasing = FALSE))/n(),
     SV_share_raw = order(order(rank(SV,ties.method = 'average'),decreasing = FALSE))/n(),
     WHIP_share = order(order(rank(WHIP,ties.method = 'average'),decreasing = FALSE))/n(),
     ERA_share = order(order(rank(ERA,ties.method = 'average'),decreasing = FALSE))/n(),
    HLD_share_raw = 0,
    Worth = Wins_share_raw+SO_share_raw+SV_share_raw+WHIP_share+ERA_share+HLD_share_raw
    ) %>% 
  ungroup() %>% 
select(-W,-SO,-SV,-WHIP,-ERA,-HLD)



options(digits=2)

df_pitching_init2021_raw =
df_pitching_init2_raw %>% 
  group_by(Name) %>% 
  filter(Season == 2021) %>% 
  arrange(desc(Worth)) %>% 
  select(Name,Wins_share_raw,SO_share_raw,SV_share_raw,WHIP_share,ERA_share,HLD_share_raw,Worth)


df_pitching_init2021_raw %>%
  filter (Worth>2.9) %>% 
  kbl() %>% 
 kable_material(c("striped", "hover","condensed","responsive"),full_width = F,fixed_thead = T)

Name	Wins_share_raw	SO_share_raw	SV_share_raw	WHIP_share	ERA_share	HLD_share_raw	Worth
Daniel Bard	0.79	0.69	0.97	0.87	0.75	0	4.0
Garrett Richards	0.79	0.84	0.86	0.87	0.68	0	4.0
Jesus Luzardo	0.77	0.78	0.55	0.89	0.92	0	3.9
Brady Singer	0.72	0.89	0.66	0.82	0.69	0	3.8
Brad Keller	0.86	0.85	0.31	0.92	0.77	0	3.7
Jose Alvarado	0.82	0.60	0.90	0.87	0.51	0	3.7
Mitch Keller	0.69	0.76	0.40	0.96	0.87	0	3.7
Justus Sheffield	0.81	0.56	0.37	0.98	0.95	0	3.7
Nick Pivetta	0.89	0.95	0.72	0.51	0.60	0	3.7
Rafael Montero	0.65	0.34	0.91	0.81	0.91	0	3.6
Josh Fleming	0.93	0.58	0.78	0.59	0.73	0	3.6
Alec Mills	0.74	0.73	0.71	0.69	0.73	0	3.6
Joe Jimenez	0.75	0.49	0.73	0.80	0.85	0	3.6
Paul Fry	0.58	0.52	0.83	0.80	0.87	0	3.6
Wil Crowe	0.61	0.82	0.53	0.84	0.78	0	3.6
Erick Fedde	0.82	0.87	0.38	0.70	0.78	0	3.5
Adam Ottavino	0.77	0.62	0.93	0.70	0.51	0	3.5
Bryan Garcia	0.50	0.22	0.85	0.98	0.98	0	3.5
Alex Reyes	0.92	0.77	0.98	0.58	0.25	0	3.5
Yusei Kikuchi	0.83	0.94	0.60	0.54	0.57	0	3.5
Zach Davies	0.74	0.83	0.19	0.87	0.83	0	3.5
Tarik Skubal	0.87	0.94	0.64	0.45	0.55	0	3.5
Vladimir Gutierrez	0.90	0.74	0.49	0.66	0.66	0	3.4
Brett de Geus	0.52	0.34	0.65	0.95	0.98	0	3.4
Andrew Heaney	0.86	0.92	0.30	0.53	0.84	0	3.4
Ryan Weathers	0.63	0.63	0.79	0.63	0.76	0	3.4
Patrick Corbin	0.88	0.90	0.09	0.72	0.84	0	3.4
Kris Bubic	0.77	0.84	0.61	0.63	0.58	0	3.4
Daniel Lynch	0.63	0.47	0.62	0.90	0.81	0	3.4
Eduardo Rodriguez	0.97	0.96	0.19	0.64	0.66	0	3.4
J.A. Happ	0.91	0.86	0.07	0.73	0.83	0	3.4
Chris Paddack	0.83	0.79	0.56	0.45	0.73	0	3.4
Cole Irvin	0.93	0.87	0.48	0.55	0.52	0	3.4
Griffin Canning	0.71	0.56	0.54	0.75	0.80	0	3.4
Matt Harvey	0.73	0.77	0.15	0.81	0.88	0	3.3
Keegan Akin	0.37	0.70	0.50	0.85	0.93	0	3.3
Dane Dunning	0.70	0.83	0.50	0.70	0.59	0	3.3
Chris Stratton	0.80	0.73	0.93	0.50	0.37	0	3.3
Cesar Valdez	0.27	0.38	0.92	0.91	0.84	0	3.3
Ben Bowden	0.51	0.35	0.57	0.97	0.92	0	3.3
Tanner Rainey	0.19	0.35	0.87	0.93	0.97	0	3.3
Matt Manning	0.62	0.49	0.58	0.79	0.83	0	3.3
Dallas Keuchel	0.88	0.76	0.09	0.81	0.76	0	3.3
Jeurys Familia	0.88	0.62	0.68	0.66	0.45	0	3.3
Kyle Finnegan	0.67	0.59	0.94	0.74	0.34	0	3.3
Jake Arrieta	0.63	0.70	0.03	0.96	0.97	0	3.3
Jorge Lopez	0.45	0.83	0.25	0.89	0.86	0	3.3
Aroldis Chapman	0.73	0.77	0.99	0.52	0.27	0	3.3
Tanner Scott	0.69	0.61	0.40	0.84	0.74	0	3.3
Dylan Cease	0.98	0.99	0.45	0.42	0.44	0	3.3
James Karinchak	0.83	0.68	0.94	0.35	0.47	0	3.3
Phil Maton	0.75	0.72	0.42	0.72	0.65	0	3.3
Jordan Lyles	0.91	0.91	0.07	0.64	0.74	0	3.3
Gregory Soto	0.76	0.66	0.97	0.59	0.28	0	3.3
Griffin Jax	0.62	0.58	0.57	0.59	0.90	0	3.3
Kyle Hendricks	0.98	0.89	0.16	0.57	0.67	0	3.3
Zach Plesac	0.93	0.80	0.55	0.32	0.64	0	3.2
Hansel Robles	0.43	0.65	0.95	0.62	0.58	0	3.2
Codi Heuer	0.84	0.48	0.85	0.53	0.54	0	3.2
Jon Gray	0.86	0.93	0.28	0.55	0.62	0	3.2
Matt Peacock	0.71	0.43	0.58	0.83	0.69	0	3.2
Carlos Estevez	0.45	0.52	0.94	0.76	0.56	0	3.2
JT Brubaker	0.69	0.88	0.39	0.50	0.77	0	3.2
German Marquez	0.96	0.95	0.28	0.46	0.57	0	3.2
Shane McClanahan	0.93	0.90	0.62	0.46	0.31	0	3.2
Logan Gilbert	0.77	0.88	0.64	0.27	0.65	0	3.2
Ryan Yarbrough	0.89	0.84	0.35	0.38	0.73	0	3.2
Rex Brothers	0.43	0.65	0.69	0.68	0.75	0	3.2
Adbert Alzolay	0.69	0.88	0.75	0.25	0.62	0	3.2
Kenta Maeda	0.76	0.83	0.45	0.51	0.64	0	3.2
Rafael Dolis	0.26	0.31	0.86	0.95	0.81	0	3.2
Amir Garrett	0.04	0.53	0.92	0.83	0.86	0	3.2
Bruce Zimmermann	0.62	0.48	0.58	0.79	0.72	0	3.2
Luis Castillo	0.86	0.96	0.31	0.60	0.46	0	3.2
Ryan Helsley	0.76	0.40	0.75	0.67	0.61	0	3.2
Trevor Stephan	0.51	0.65	0.78	0.66	0.57	0	3.2
Kyle Freeland	0.81	0.82	0.33	0.67	0.55	0	3.2
Luis Garcia	0.95	0.95	0.66	0.30	0.32	0	3.2
Mike Mayers	0.68	0.74	0.83	0.49	0.43	0	3.2
Eli Morgan	0.71	0.69	0.57	0.43	0.76	0	3.2
Sam Hentges	0.20	0.60	0.45	0.96	0.93	0	3.1
Ryan Hendrix	0.71	0.26	0.51	0.82	0.85	0	3.1
Daniel Norris	0.30	0.51	0.71	0.76	0.87	0	3.1
Trevor May	0.78	0.70	0.88	0.43	0.35	0	3.1
Drew Smyly	0.94	0.84	0.15	0.61	0.59	0	3.1
Alex Colome	0.54	0.50	0.96	0.64	0.49	0	3.1
Kwang-hyun Kim	0.84	0.69	0.80	0.49	0.31	0	3.1
Taylor Hearn	0.76	0.76	0.43	0.53	0.63	0	3.1
Brad Hand	0.73	0.53	0.97	0.45	0.44	0	3.1
Kyle Zimmer	0.57	0.38	0.83	0.65	0.68	0	3.1
Adam Plutko	0.18	0.37	0.73	0.90	0.94	0	3.1
Josiah Gray	0.40	0.66	0.66	0.60	0.78	0	3.1
Kyle Funkhouser	0.83	0.57	0.77	0.65	0.30	0	3.1
JC Mejia	0.24	0.40	0.59	0.88	0.99	0	3.1
Tylor Megill	0.62	0.79	0.61	0.48	0.60	0	3.1
Bryan Shaw	0.73	0.62	0.81	0.62	0.32	0	3.1
Josh Sborz	0.60	0.61	0.75	0.67	0.45	0	3.1
Tyler Mahle	0.98	0.98	0.34	0.38	0.40	0	3.1
Hyun-Jin Ryu	0.99	0.90	0.25	0.37	0.56	0	3.1
Austin Gomber	0.89	0.83	0.35	0.39	0.60	0	3.1
Max Kranick	0.39	0.22	0.63	0.94	0.89	0	3.1
Steven Matz	0.98	0.91	0.21	0.55	0.42	0	3.1
Luis Oviedo	0.25	0.20	0.63	0.99	0.99	0	3.1
Martin Perez	0.78	0.77	0.07	0.78	0.66	0	3.1
Spencer Howard	0.11	0.44	0.65	0.88	0.97	0	3.1
Ian Anderson	0.90	0.86	0.55	0.39	0.35	0	3.0
Aaron Nola	0.89	0.99	0.33	0.22	0.63	0	3.0
Jake Brentz	0.69	0.66	0.84	0.47	0.38	0	3.0
Enyel De Los Santos	0.35	0.41	0.44	0.95	0.90	0	3.0
Matt Barnes	0.74	0.71	0.98	0.21	0.41	0	3.0
Matt Andriese	0.29	0.42	0.70	0.88	0.75	0	3.0
Sean Manaea	0.95	0.96	0.32	0.38	0.44	0	3.0
Zac Gallen	0.61	0.90	0.49	0.50	0.54	0	3.0
J.B. Wendelken	0.57	0.31	0.83	0.78	0.54	0	3.0
Greg Holland	0.41	0.45	0.92	0.57	0.68	0	3.0
Alex Young	0.35	0.36	0.44	0.96	0.92	0	3.0
Matt Foster	0.37	0.33	0.77	0.70	0.85	0	3.0
Bryan Abreu	0.47	0.27	0.74	0.73	0.82	0	3.0
Kolby Allard	0.49	0.81	0.46	0.48	0.78	0	3.0
Junior Guerra	0.64	0.53	0.05	0.94	0.86	0	3.0
Heath Hembree	0.29	0.71	0.93	0.30	0.79	0	3.0
Archie Bradley	0.80	0.32	0.82	0.68	0.39	0	3.0
Luis Patino	0.72	0.64	0.65	0.46	0.54	0	3.0
Trevor Williams	0.59	0.74	0.36	0.76	0.55	0	3.0
Caleb Smith	0.57	0.86	0.28	0.62	0.68	0	3.0
David Peterson	0.38	0.61	0.57	0.65	0.79	0	3.0
Jake Diekman	0.41	0.70	0.91	0.56	0.43	0	3.0
Triston McKenzie	0.70	0.89	0.42	0.29	0.70	0	3.0
Jeff Hoffman	0.48	0.68	0.38	0.85	0.61	0	3.0
Lou Trivino	0.81	0.59	0.97	0.41	0.22	0	3.0
Sean Newcomb	0.33	0.36	0.74	0.93	0.65	0	3.0
James Kaprielian	0.87	0.86	0.43	0.37	0.47	0	3.0
Lucas Sims	0.66	0.66	0.92	0.20	0.56	0	3.0
Blake Snell	0.80	0.95	0.21	0.53	0.51	0	3.0
Brent Suter	0.96	0.60	0.72	0.52	0.20	0	3.0
Randy Dobnak	0.25	0.15	0.79	0.82	0.98	0	3.0
Jon Lester	0.78	0.75	0.04	0.78	0.65	0	3.0
Jose Urena	0.55	0.59	0.14	0.87	0.83	0	3.0
Vince Velasquez	0.43	0.80	0.13	0.74	0.89	0	3.0
Jacob Webb	0.70	0.23	0.76	0.79	0.50	0	3.0
Mike Minor	0.85	0.92	0.10	0.39	0.72	0	3.0
Cristian Javier	0.60	0.88	0.84	0.29	0.34	0	3.0
Paul Sewald	0.92	0.81	0.94	0.10	0.19	0	3.0
Chad Kuhl	0.67	0.65	0.28	0.68	0.68	0	3.0
Paolo Espino	0.64	0.75	0.69	0.33	0.53	0	3.0
David Price	0.63	0.49	0.68	0.67	0.46	0	2.9
Jordan Montgomery	0.75	0.94	0.35	0.47	0.43	0	2.9
Aaron Bummer	0.68	0.65	0.84	0.44	0.33	0	2.9
Jose Suarez	0.87	0.72	0.54	0.39	0.40	0	2.9
Paul Campbell	0.39	0.14	0.63	0.86	0.91	0	2.9
Bryse Wilson	0.51	0.39	0.55	0.71	0.77	0	2.9
Carlos Hernandez	0.77	0.64	0.65	0.48	0.38	0	2.9
Hector Neris	0.56	0.78	0.95	0.26	0.37	0	2.9
Stefan Crichton	0.05	0.02	0.89	0.99	0.96	0	2.9
Reid Detmers	0.26	0.04	0.67	0.97	0.97	0	2.9
Aaron Civale	0.96	0.79	0.51	0.21	0.43	0	2.9
Riley Smith	0.23	0.27	0.78	0.77	0.86	0	2.9

NA

---

3.3 2021 Player Rankings - Actual Performance

3.3.1 2021 Player Rankings - Top Worth Players

Total Rankings for the players (Using 5x5 Scoring) can be found here. While it looks like many of the top players have low worth scores, it is because we haven’t applied a modifier for IP yet.

options(digits=2)

df_pitching_init2021 =
df_pitching_init2 %>% 
  group_by(Name) %>% 
  filter(Season == 2021) %>% 
  arrange(desc(Worth)) %>% 
  select(Name,Wins_share,SO_share,SV_share,WHIP_share,ERA_share,HLD_share,Worth)


df_pitching_init2021 %>%
  filter (Worth>3.9) %>% 
  kbl() %>% 
 kable_material(c("striped", "hover","condensed","responsive"),full_width = F,fixed_thead = T)

Name	Wins_share	SO_share	SV_share	WHIP_share	ERA_share	HLD_share	Worth
Daniel Bard	0.93	0.85	0.97	0.87	0.75	0	4.4
Joe Jimenez	0.98	0.86	0.76	0.80	0.85	0	4.2
Paul Fry	0.83	0.87	0.82	0.80	0.87	0	4.2
Rafael Dolis	0.63	0.84	0.89	0.95	0.81	0	4.1
Ben Bowden	0.83	0.82	0.57	0.97	0.92	0	4.1
Jose Alvarado	0.96	0.85	0.89	0.87	0.51	0	4.1
Tanner Rainey	0.22	0.93	0.89	0.93	0.97	0	3.9
Sean Newcomb	0.62	0.93	0.79	0.93	0.65	0	3.9
Ryan Hendrix	1.00	0.73	0.51	0.82	0.85	0	3.9

NA

---

4 Creating Model File

4.1 Additional Data Prep

4.1.1 Remove Variables which are based off current hitting numbers

Not all variables can be used for predictive modeling.

df_pitching_init3 = df_pitching_init2
#Be careful about RS - Run Support and RS/9

  

Lag Share Variables to use for predictive modeling. The variables that we created for the Worth metric must also be removed. This will create the final dataset.

#Order the dataset by lag columns
df_pitching_init4 =  arrange(df_pitching_init3, playerid,Season) #playerid is the Fangraph id assigned to each player

# Convert dataframe to data.table format
DT_pitcher2 = data.table(df_pitching_init4)

#designate columns to lag - just the new shares
cols1 = (c('Wins_share','SO_share','SV_share', 'ERA_share','WHIP_share','HLD_share','Worth'))
anscols = paste("lag", cols1, sep="_") 
DT_pitcher2[, (anscols) := data.table::shift(.SD, 1, NA, "lag"),by ='playerid', .SDcols=cols1] #Create 1 period lags by year

df_pitching_final = as.data.frame(DT_pitcher2) %>% 
  select(-c(Wins_share,SO_share,SV_share, ERA_share,WHIP_share,HLD_share,Name))%>% 
select(-FIP,-(RAR:WPA),-(wFB:wCH),-(`ERA-`:`xFIP-`),
       -SIERA,-(`RA9-WAR`:`Age Rng`),-kwERA,-(`wCH (pi)`:`wSL (pi)`),-(`K/9+`:`HR/FB%+`)) %>% select(-W,-SO,-SV,-HLD,-W_IP,-SO_IP,-SV_IP,-WHIP,-ERA,-HLD_IP)

4.1.2 Creating Training/Test Split

We split the data into Training Data (which is used to create the model) and test data (which is used to validate the model)

set.seed(15674)  # For reproducibility
# Create index for testing and training data
inTrain <- createDataPartition(y = df_pitching_final$Worth, p = 0.80, list = FALSE)
# subset pitching data for training
tr_2021 <- df_pitching_final[inTrain,]
# subset the rest to test and validate trained model
te_2021 <- df_pitching_final[-inTrain,]

nrow(tr_2021)/nrow(df_pitching_final) #check if split is 0.8

[1] 0.8

4.1.3 Treat Missing Data by Imputing Mean Value

Vtreat Package in R is excellent for treating data before using for modeling. Additional documentation can be found here.

---

4.1.4 Check Distribution of Training Population

The population used for Training should be indicative of Total Population

ggplot2::qplot(tr_treated_2021$Worth, main="Training Set") + geom_histogram(colour="black", fill="grey") + theme_bw()

`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

skewness(tr_treated_2021$Worth) #The skewness is the same as the overall

[1] 0.077

---

5 Running XGboost Model

To keep things simple with modeling, we’ll turn the training data into simple input variables for caret::train, dropping the response variable and converting the data frame to a matrix. Documentation for this approach to XGboost can be found here.

5.1 Tuning the Model

5.1.1 Initial Non-Tuned Model

Break the data set into x and y inputs with x being a matrix

input_x <- as.matrix(((tr_treated_2021))%>%
   select(-Worth) %>%                      
   select(!ends_with ("_isBAD")))

input_y <- tr_treated_2021$Worth

XGBoost with Default Hyperparameters
The Variable Importance (caret::varImp(xgb_base_2021, scale = F )) from the caret package shows the contribution of each variable to the initial model. As you can see SLG_plus_ (SLG+) takes up much of the importance as it is derived from SLG (one of the key contributors to Worth). These types of variables will be removed during variable selection in the next step.
XGBoost documentation can be found for more general models here.

#Defaults for xgboost model
grid_default <- expand.grid(
  nrounds = 100,
  max_depth = 6,
  eta = 0.3,
  gamma = 0,
  colsample_bytree = 1,
  min_child_weight = 1,
  subsample = 1
)

#This is a blank train_control set, this will be updated after
train_control <- caret::trainControl(
  method = "none",
  verboseIter = FALSE, # no training log
  allowParallel = TRUE # FALSE for reproducible results 
)

xgb_base_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = train_control,
  tuneGrid = grid_default,
  method = "xgbTree",
  verbose = TRUE
)

caret::varImp(xgb_base_2021, scale = F  )

xgbTree variable importance

  only 20 most important variables shown (out of 773)

---

5.2 Further Variable Selection

5.2.1 Remove redundant and highly correlated variables

Selection Removal Step 1: Check for high correlations
Normally, this step is done early, but those steps were reserved for preparing the data

dep_cor1 <- t(as.data.frame(cor(tr_treated_2021[ , colnames(tr_treated_2021) != "Worth"],
                tr_treated_2021$Worth)))
dep_cor1 <-
as.data.frame(t(as.data.frame(dep_cor1)%>% 
  select(!starts_with("lag")) %>% #remove lag variables
  select(!contains("_isBAD")))) 

dep_cor1 <- tibble::rownames_to_column(dep_cor1,"VARIABLES")%>% #remove indicators for missing data
  filter(V1 > 0.40|V1 < -0.3)

dep_cor1

dep_cor2 <- colnames(row_to_names(t(dep_cor1),row_number = 1))

Let’s Remove variables with high correlation to worth metric, and metrics that are calculated after a player’s performance (such as WAR)

input_x <- as.matrix(((tr_treated_2021))%>%
   select(-Worth) %>% #Remove some variables variables
     select (-RS_IP,-ER_IP,-R_IP,-REW,-RE24,-Clutch,-WPA_slash_LI,-Season #Remove redundant variables or non/weighted variables
) %>%      
select(!ends_with ("_isBAD"))) #indicator variable for missing data

input_y <- tr_treated_2021$Worth

Run the model on the new dataset to make sure the variable importances look fine

#Note Training parameters were set in initial model set up
xgb_base_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = train_control,
  tuneGrid = grid_default,
  method = "xgbTree",
  verbose = TRUE
)

caret::varImp(xgb_base_2021, scale = F  )

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.3 Model with new data

5.3.1 Tuning All Hyperparameters

A tune grid allows us to test a large amount of hyper-parameters and find the model with the lowest RMSE for predictions.
However, The more values you want to test and the greater the amount of Cross-Fold Validations (method = "cv"), the greater the computational time it will take. More information on the specific parameters can be found here.

# maximum number of trees
nrounds <- 1000

# note to start nrounds from 200, as smaller learning rates result in errors so
# big with lower starting points that they'll mess the scales
tune_grid <- expand.grid(
  nrounds = seq(from = 100, to = nrounds, by = 50),
  eta = c(0.01, 0.025, 0.05, 0.075, 0.1),
  max_depth = c(2, 4, 6, 8, 10),
  gamma = 0,
  colsample_bytree = 1,
  min_child_weight = 1,
  subsample = 1
)

tune_control <- caret::trainControl(
  method = "cv", # cross-validation
  number = 5, # with n folds 
  ## Note this was # out in the original code
  #index = createFolds(tr_treated$Id_clean), # fix the folds
  verboseIter = FALSE, # no training log
  allowParallel = TRUE # FALSE for reproducible results 
)

Running the initial tuning model

#Note I will be timing these runs to give an estimate on how long this model takes to run
start_time <- Sys.time()

xgb_tune_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = tune_control,
  tuneGrid = tune_grid,
  method = "xgbTree",
  verbose = FALSE
  ,verbosity = 0
)

end_time <- Sys.time()

end_time - start_time

Time difference of 22 mins

Tuning Plot and Variable Importance

varImp(xgb_tune_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

# helper function for the plots
tuneplot <- function(x, probs = .90) {
  ggplot(x) +
    coord_cartesian(ylim = c(quantile(x$results$RMSE, probs = probs), min(x$results$RMSE))) +
    theme_bw()
}

tuneplot(xgb_tune_2021)

---

5.3.2 Fine Tuning Model

5.3.2.1 Second Tuning: Maximum Depth and Minimum Child Weight

After fixing the learning rate to 0.1 and we’ll also set maximum depth to 3 +-1 (or +2 if max_depth == 2) to experiment a bit around the suggested best tune in previous step. Then, well fix maximum depth and minimum child weigh

tune_grid2 <- expand.grid(
  nrounds = seq(from = 50, to = nrounds, by = 50),
  eta = xgb_tune_2021$bestTune$eta,
  max_depth = ifelse(xgb_tune_2021$bestTune$max_depth == 2,
    c(xgb_tune_2021$bestTune$max_depth:4),
    xgb_tune_2021$bestTune$max_depth - 1:xgb_tune_2021$bestTune$max_depth + 1),
  gamma = 0,
  colsample_bytree = 1,
  min_child_weight = c(1, 2, 3),
  subsample = 1
)

xgb_tune2_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = tune_control,
  tuneGrid = tune_grid2,
  method = "xgbTree",
  verbose = TRUE
)

tuneplot(xgb_tune2_2021)

xgb_tune2_2021$bestTune

varImp(xgb_tune2_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.3.2.2 Third Tuning: Column and Row Sampling

tune_grid3 <- expand.grid(
  nrounds = seq(from = 50, to = nrounds, by = 50),
  eta = xgb_tune_2021$bestTune$eta,
  max_depth = xgb_tune2_2021$bestTune$max_depth,
  gamma = 0,
  colsample_bytree = c(0.4, 0.6, 0.8, 1.0),
  min_child_weight = xgb_tune2_2021$bestTune$min_child_weight,
  subsample = c(0.5, 0.75, 1.0)
)

xgb_tune3_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = tune_control,
  tuneGrid = tune_grid3,
  method = "xgbTree",
  verbose = TRUE
)

tuneplot(xgb_tune3_2021, probs = .95)

xgb_tune3_2021$bestTune

varImp(xgb_tune3_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.3.2.3 Fourth Tuning: Gamma

Next, we again pick the best values from previous step, and now will see whether changing the gamma has any effect on the model fit:

tune_grid4 <- expand.grid(
  nrounds = seq(from = 50, to = nrounds, by = 50),
  eta = xgb_tune_2021$bestTune$eta,
  max_depth = xgb_tune2_2021$bestTune$max_depth,
  gamma = c(0, 0.05,0.1, 0.2,0.4, 0.5, 0.7, 0.9, 1.0),
  colsample_bytree = xgb_tune3_2021$bestTune$colsample_bytree,
  min_child_weight = xgb_tune2_2021$bestTune$min_child_weight,
  subsample = xgb_tune3_2021$bestTune$subsample
)

xgb_tune4_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = tune_control,
  tuneGrid = tune_grid4,
  method = "xgbTree",
  verbose = TRUE
)

tuneplot(xgb_tune4_2021)

Warning: The shape palette can deal with a maximum of 6 discrete values because more than 6
becomes difficult to discriminate; you have 9. Consider specifying shapes manually if you
must have them.
Warning: Removed 60 rows containing missing values (geom_point).

xgb_tune4_2021$bestTune

varImp(xgb_tune4_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.3.2.4 Fifth Tuning: Reducing the Learning Rate

Now, we have tuned the hyperparameters and can start reducing the learning rate to get to the final model:

start_time <- Sys.time()

tune_grid5 <- expand.grid(
  nrounds = seq(from = 100, to = 10000, by = 75),
   eta = c(0.01, 0.015, 0.025,0.035, 0.05,0.75, 0.1),
  max_depth = xgb_tune2_2021$bestTune$max_depth,
  gamma = xgb_tune4_2021$bestTune$gamma,
  colsample_bytree = xgb_tune3_2021$bestTune$colsample_bytree,
  min_child_weight = xgb_tune2_2021$bestTune$min_child_weight,
  subsample = xgb_tune3_2021$bestTune$subsample
)



xgb_tune5_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = tune_control,
  tuneGrid = tune_grid5,
  method = "xgbTree",
  verbose = TRUE
)

#tuneplot(xgb_tune5_2021)

end_time <- Sys.time()

end_time - start_time

Time difference of 28 mins

xgb_tune5_2021$bestTune

varImp(xgb_tune5_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.3.2.5 Fitting Final Model

(final_grid_2021 <- expand.grid(
  nrounds = xgb_tune5_2021$bestTune$nrounds,
  eta = xgb_tune5_2021$bestTune$eta,
  max_depth = xgb_tune5_2021$bestTune$max_depth,
  gamma = xgb_tune5_2021$bestTune$gamma,
  colsample_bytree = xgb_tune5_2021$bestTune$colsample_bytree,
  min_child_weight = xgb_tune5_2021$bestTune$min_child_weight,
  subsample = xgb_tune5_2021$bestTune$subsample
))

(xgb_model_2021 <- caret::train(
  x = input_x,
  y = input_y,
  trControl = train_control,
  tuneGrid = final_grid_2021,
  method = "xgbTree",
  verbose = TRUE
))

eXtreme Gradient Boosting 

3196 samples
 765 predictor

No pre-processing
Resampling: None 

varImp(xgb_model_2021, scale = F  ) 

xgbTree variable importance

  only 20 most important variables shown (out of 765)

---

5.4 Model Performance

5.4.1 Checking Model on Test Split Data

We don’t need to look too closely at are training data as Xgboost will heavily overfit the model based on that data. The more important part is how the model performs on in predicting our Test Sample that was not included.

y_pred_test <- predict(xgb_model_2021, data.matrix(te_treated_2021))

test_stats= cbind((te_treated_2021$Worth),y_pred_test)

test_statsR2 = cor(test_stats[,1],test_stats[,2])^2

print(test_statsR2)

[1] 0.71

y_pred_train <- predict(xgb_model_2021, data.matrix(tr_treated_2021))

train_stats = cbind((tr_treated_2021$Worth),y_pred_train)

train_statsR2 = cor(train_stats[,1],train_stats[,2])^2

print(train_statsR2)

[1] 0.98

#test dataset
x <- select(te_treated_2021, -Worth)
y <- (te_treated_2021$Worth)

(xgb_model_rmse <- ModelMetrics::rmse(y, predict(xgb_model_2021, newdata = x)))

[1] 0.34

holdout_x <- select(tr_treated_2021, -Worth)
holdout_y <- tr_treated_2021$Worth

(xgb_model_rmse <- ModelMetrics::rmse(holdout_y, predict(xgb_model_2021, newdata = holdout_x)))

[1] 0.081

5.4.1.1 Graphical Representation of Model

ggplot2::ggplot() +
  aes(x = test_stats[,1], y = test_stats[,2]) +
  geom_jitter() +
  xlab("Predicted Values") +
  ylab("Actual Values") +
  ggtitle("Results of Pitching Model on Test Data")+
  theme(plot.title = element_text(hjust = 0.5,size = 22,color ="steel blue"))+
  geom_smooth(method = "lm")

`geom_smooth()` using formula 'y ~ x'

---

6 Creating 2022 Projections from Model

6.1 Re-fit model for Important Variables

Now that we have an acceptable model, we can use it to create projections for how well we think players should do in 2022 based on their hitting statistics in 2021. First let’s reduce

1. Only keep variables with high enough importance in model

variables_to_keep_2022

 [1] "Pitches_IP"                                "TBF_IP"                                   
 [3] "E_minus_F"                                 "TTO_percent_"                             
 [5] "BABIP"                                     "K_slash_9"                                
 [7] "lag_SV_share"                              "RS_slash_9"                               
 [9] "Strikes_IP"                                "pLI"                                      
[11] "inLI"                                      "playerid"                                 
[13] "K_percent_"                                "gmLI"                                     
[15] "Age"                                       "SD_IP"                                    
[17] "BB_IP"                                     "Balls_IP"                                 
[19] "Relieving"                                 "HR_slash_FB"                              
[21] "AVG"                                       "Pulls_IP"                                 
[23] "H_IP"                                      "wFB_slash_C"                              
[25] "H_slash_9"                                 "BS_IP"                                    
[27] "BB_slash_9"                                "LOB_percent_"                             
[29] "HR_IP"                                     "HR_slash_9"                               
[31] "MD_IP"                                     "BB_percent_"                              
[33] "Pace"                                      "IBB_IP"                                   
[35] "wFA_oparen_sc_cparen_"                     "T_Rep"                                    
[37] "exLI"                                      "EV"                                       
[39] "wFA_slash_C_oparen_sc_cparen_"             "T_minus_WPA"                              
[41] "Relief_minus_IP"                           "Hard_percent_plus_"                       
[43] "HBP_IP"                                    "T_vCH_oparen_sc_cparen_"                  
[45] "lag_SV_IP"                                 "O_minus_Contact_percent_oparen_sc_cparen_"
[47] "T_SI_percent_oparen_pi_cparen_"            "Contact_percent_oparen_sc_cparen_"        
[49] "Contact_percent_oparen_pi_cparen_"         "WP_IP"                                    
[51] "HardHits_IP"                               "lag_Barrels_IP"                           
[53] "L_IP"                                      "Contact_percent_"                         
[55] "lag_Wins_share"                            "wSL_slash_C"                              
[57] "Z_minus_Swing_percent_"                    "T_fastball_perc"                          
[59] "wFA_slash_C_oparen_pi_cparen_"             "O_minus_Contact_percent_oparen_pi_cparen_"
[61] "LD_percent_"                               "O_minus_Swing_percent_"                   
[63] "O_minus_Contact_percent_"                  "T_SL_percent_"                            
[65] "T_WPA"                                     "Cent_percent_"                            
[67] "T_FBv"                                     "lag_MD_IP"                                
[69] "K_minus_BB_percent_"                       "lag_Pulls_IP"                             
[71] "lag_H_slash_9_plus_"                       "O_minus_Swing_percent_oparen_pi_cparen_"  
[73] "Soft_percent_plus_"                        "wCU_slash_C_oparen_sc_cparen_"            
[75] "CH_minus_Z_oparen_sc_cparen_"              "wSL_slash_C_oparen_sc_cparen_"            
[77] "IFH_IP"                                    "lag_gmLI"                                 
[79] "T_vFA_oparen_sc_cparen_"                   "Cent_percent_plus_"                       
[81] "T_Strikes_T_PA"                            "Start_minus_IP"                           
[83] "lag_SV"                                    "vFA_oparen_pi_cparen_"                    
[85] "O_minus_Swing_percent_oparen_sc_cparen_"   "HardHit_percent_"                         
[87] "wCH_oparen_sc_cparen_"                     "lag_SD_IP"                                
[89] "T_SL_percent_oparen_pi_cparen_"            "Zone_percent_"                            
[91] "Swing_percent_"                            "wCB_slash_C"                              
[93] "LD_IP"                                     "Barrels_IP"                               

---

2. Re-fit model with reduced variable scope

(final_grid_2021 <- expand.grid(
  nrounds = xgb_tune5_2021$bestTune$nrounds,
  eta = xgb_tune5_2021$bestTune$eta,
  max_depth = xgb_tune5_2021$bestTune$max_depth,
  gamma = xgb_tune5_2021$bestTune$gamma,
  colsample_bytree = xgb_tune5_2021$bestTune$colsample_bytree,
  min_child_weight = xgb_tune5_2021$bestTune$min_child_weight,
  subsample = xgb_tune5_2021$bestTune$subsample
))

(xgb_model_2022 <- caret::train(
  x = input_x_2022,
  y = input_y_2022,
  trControl = train_control,
  tuneGrid = final_grid_2021,
  method = "xgbTree",
  verbose = TRUE
))

eXtreme Gradient Boosting 

3196 samples
 125 predictor

No pre-processing
Resampling: None 

vip(xgb_model_2022, num_features = 30)

unscalevi24 = vi(xgb_model_2022, method="model")

unscalevi24$Importance_perc = with(unscalevi24,Importance/sum(Importance)) 

unscalevi24

save(xgb_model_2022,file = '2022_Pitching5x5_Model.Rdata')

---

6.2 Get 2022 list of players

6.2.1 Arrange the Data so the Columns are in the exact order as the model

First let’s prepare a file for predicting based on our model object

Data_Predict_2022a = df_pitching_init2 %>% select (one_of(colnames(variables_nolag)),Season,playerid)

Warning: Unknown columns: `H_slash_9_plus_`

---

6.3 Create Predictions for Model

6.3.1 Run Projections on Players who Played in 2021

This is the raw prediction score per IP for each pitcher

---

6.3.2 Load in Latest 2022 Projections for Innings Pitched

Downloaded from FanGraphs here.

---

---

7 2022 Projections Full

7.1 Table of Pitching Projections (Players who Didn’t Play in 2021 - Recieve an NA)

AdjPredict_Score are normalized to 100